This script downloads and maps recent eBird data from a Christmas Bird Count circle. It is useful for helping participants to “scout” birds that may occur in their circle/section. This example is run for the West Hennepin 2023 count circle, but it could easily be adapted to other counts.
# Name for run (create output directory)
tag <- "West_Hennepin_20231224"
# Define the center coordinates and circle radius
center_lat <- 45.09468
center_long <- -93.63574
center <- c(center_long, center_lat)
radius_km <- 12.07
# How many days back to pull data?
time_days <- 30
# today <- Sys.Date()
today <- "2023-12-24"# Create a circular buffer using the center and radius
circle <- st_buffer(st_sfc(st_point(center), crs = 4326), dist = radius_km * 1000)
bbox <- st_bbox(circle)
recent_sigtings_file <- here("Projects", "CBC_Scouting", tag, "CBC_sightings_recent.RDS")
if (file.exists(recent_sigtings_file)) {
CBC_sightings_recent <- readRDS(recent_sigtings_file)
} else {
# Get recent species
sp_list <- ebirdgeo(lat = center_lat, lng = center_long, dist = radius_km, back = time_days) %>%
pull(speciesCode)
CBC_sightings_recent_raw <- mapply(ebirdgeo, species = sp_list, lat = center_lat, lng = center_long, dist = radius_km, back = time_days)
# Combine in one dataframe
CBC_sightings_recent <- bind_rows(
lapply(CBC_sightings_recent_raw, function(df) {
if ("exoticCategory" %in% colnames(df)) {
# If "exoticCategory" column is present, keep it, else create it with NA values
df <- df %>%
mutate(exoticCategory = ifelse(!("exoticCategory" %in% colnames(df)), NA, as.character(exoticCategory)))
} else {
# If "exoticCategory" column is not present, create it with NA values
df$exoticCategory <- NA_character_
}
return(df)
})
)
saveRDS(CBC_sightings_recent, recent_sigtings_file)
}# Map will bin observations into which week they were observed.
# First project and format date field
CBC_sightings_recent <- CBC_sightings_recent %>%
st_as_sf(coords = c("lng", "lat"), crs = 4326) %>%
mutate(Date = as.Date(obsDt))
# Bin dates (approximate number of weeks)
num_bins <- round(time_days / 7, 0)
# Calculate bin edges, extending the range slightly beyond the minimum and maximum dates
min_date <- min(CBC_sightings_recent$Date) - 1
max_date <- max(CBC_sightings_recent$Date)
bin_edges <- seq(min_date, max_date, length.out = num_bins + 1)
# Bin the Date variable
CBC_sightings_recent$DateBin <- cut(CBC_sightings_recent$Date, breaks = bin_edges, labels = FALSE, right = TRUE)
# Get a map tile from a map service (e.g., Stadia Alidade). This ill throw an error if API key isn't in .Renviron.
map_tile <- get_stadiamap(bbox = c(bbox[[1]], bbox[[2]], bbox[[3]], bbox[[4]]), zoom = 11, maptype = "alidade_smooth")
# Generate map
p <- ggmap(map_tile) +
geom_sf(data = circle, fill = "transparent", color = "grey20", size = 1, inherit.aes = FALSE) +
geom_sf(data = st_jitter(CBC_sightings_recent), size = 1.5, alpha = .9, aes(color = as.factor(DateBin)), inherit.aes = FALSE) +
scale_color_manual(name = "Week starting:", values = rev(viridisLite::inferno(num_bins)), labels = format(bin_edges, "%Y-%m-%d")) +
ggthemes::theme_map() +
theme(
legend.position = "top",
legend.justification = "right",
legend.background = element_rect(
fill = "grey90",
linewidth = 0.25, linetype = "solid",
colour = "grey40"
),
legend.key = element_rect(fill = "grey90"),
plot.title = element_text(size = 8, face = "bold"),
plot.subtitle = element_text(size = 6, face = "italic"),
strip.text = element_text(size = 6)
) +
facet_wrap(~comName) +
labs(
title = "West Hennepin CBC: recent eBird observations",
subtitle = paste0("Data from 30 day period ending ", today)
)
ggsave(plot = p, here("Projects", "CBC_Scouting", tag, paste0(tag, "_recent_ebird_data.pdf")), width = 8.5, height = 11)
precent_hotspots_sigtings_file <- here("Projects", "CBC_Scouting", tag, "CBC_hotspot_sightings_recent.RDS")
hotspots_file <- here("Projects", "CBC_Scouting", tag, "CBC_hotspots.RDS")
if (file.exists(recent_hotspots_sigtings_file) & file.exists(hotspots_file)) {
CBC_hotspot_sightings_recent <- readRDS(recent_hotspots_sigtings_file)
CBC_hotspots <- readRDS(hotspots_file)
} else {
CBC_hotspots <- rebird::ebirdhotspotlist(lat = center_lat, lng = center_long, dist = radius_km) %>%
st_as_sf(coords = c("lng", "lat"), crs = 4326)
saveRDS(CBC_hotspots, hotspots_file)
mapview(CBC_hotspots, label = "locName")
CBC_hotspot_sightings_recent <- sapply(CBC_hotspots$locId, ebirdregion, simple = FALSE, back = time_days)
# Combine in one data frame
CBC_hotspot_sightings_recent <- bind_rows(
lapply(CBC_hotspot_sightings_recent, function(df) {
if ("exoticCategory" %in% colnames(df)) {
# If "exoticCategory" column is present, keep it, else create it with NA values
df <- df %>%
mutate(exoticCategory = ifelse(!("exoticCategory" %in% colnames(df)), NA, as.character(exoticCategory)))
} else {
# If "exoticCategory" column is not present, create it with NA values
df$exoticCategory <- NA_character_
}
return(df)
})
)
CBC_hotspot_sightings_recent <- CBC_hotspot_sightings_recent %>%
replace_na(list(howMany = 1))
saveRDS(CBC_hotspot_sightings_recent, recent_hotspots_sigtings_file)
}
# Generate table with recent species observed at each hotspot (with date last documented)
species_by_hotspot <- CBC_hotspot_sightings_recent %>%
mutate(obsDtmd = format(as.Date(obsDt), "%m-%d")) %>%
pivot_wider(id_cols = comName, names_from = locName, values_from = obsDtmd, values_fn = max) %>%
left_join(rebird:::tax %>% select(comName, taxonOrder)) %>%
arrange(taxonOrder) %>%
select(-taxonOrder)
species_by_hotspot[is.na(species_by_hotspot)] <- ""
species_by_hotspot <- species_by_hotspot %>%
select(sort(tidyselect::peek_vars())) %>%
select(comName, everything())
species_by_hotspot %>%
datatable(
options = list(pageLength = 25),
caption = "Hotspots each species has been recently documented in"
)write.csv(species_by_hotspot, here("Projects", "CBC_Scouting", tag, "species_by_hotspot_last_seen.csv"))
count_hotspots_by_sp <- CBC_hotspot_sightings_recent %>%
group_by(comName) %>%
summarize(
n_hotspots_observed = length(unique(locName)),
parks_observed = paste(sort(unique(locName)), collapse = ", ")
) %>%
left_join(rebird:::tax %>% select(comName, taxonOrder)) %>%
arrange(taxonOrder) %>%
select(-taxonOrder) %>%
arrange(desc(n_hotspots_observed))
count_hotspots_by_sp %>%
datatable(
options = list(pageLength = 25),
caption = "Number of hotspots each species has recently been observed in"
)write.csv(species_by_hotspot, here("Projects", "CBC_Scouting", tag, "count_hotspots_by_sp_raw.csv"))
# rare sp are those seen in fewer than 30% of hotspots
rare_sp <- count_hotspots_by_sp %>%
filter(n_hotspots_observed <= nrow(CBC_hotspots) * .3) %>%
pull(comName)
# unique sp are those seen in only 1 hotspot
unique_sp <- count_hotspots_by_sp %>%
filter(n_hotspots_observed == 1) %>%
pull(comName)
count_sp_by_hotspot <- CBC_hotspot_sightings_recent %>%
group_by(locName) %>%
summarize(
n_sp = length(unique(comName)),
n_rare_sp = length(intersect(rare_sp, unique(comName))),
n_unique_sp = length(intersect(unique_sp, unique(comName))),
rare_sp = paste(sort(intersect(rare_sp, unique(comName))), collapse = ", "),
unique_sp = paste(sort(intersect(unique_sp, unique(comName))), collapse = ", ")
) %>%
arrange(desc(n_sp))
write.csv(species_by_hotspot, here("Projects", "CBC_Scouting", tag, "count_sp_by_hotspot_raw.csv"))
count_sp_by_hotspot %>%
datatable(
options = list(pageLength = 25),
caption = "Hotspots with total number of recently species and rare/unique species. Rare species are those seen in <=30% of hotspots."
)## R version 4.2.2 (2022-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 22621)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=English_United States.utf8 LC_CTYPE=English_United States.utf8
## [3] LC_MONETARY=English_United States.utf8 LC_NUMERIC=C
## [5] LC_TIME=English_United States.utf8
##
## attached base packages:
## [1] parallel stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] ggmap_4.0.0 rebird_1.3.0 CoordinateCleaner_3.0.1
## [4] rgbif_3.7.8 MASS_7.3-58.1 viridis_0.6.4
## [7] viridisLite_0.4.2 effects_4.2-2 carData_3.0-5
## [10] knitr_1.45 snakecase_0.11.1 DHARMa_0.4.6
## [13] glmmTMB_1.1.8 performance_0.10.8 insight_0.19.7
## [16] gridExtra_2.3 jagsUI_1.5.2 png_0.1-8
## [19] transformr_0.1.3 gifski_1.12.0-2 gganimate_1.0.8
## [22] ggspatial_1.1.9 ggrepel_0.9.4 RVAideMemoire_0.9-83-7
## [25] pairwiseAdonis_0.4.1 cluster_2.1.4 goeveg_0.6.5
## [28] vegan_2.6-4 lattice_0.20-45 permute_0.9-7
## [31] mapview_2.11.2 ggtext_0.1.2 ratelimitr_0.4.1
## [34] rvest_1.0.3 trelliscopejs_0.2.6 plotly_4.10.3
## [37] auk_0.7.0 readxl_1.4.3 kableExtra_1.3.4
## [40] ggthemes_5.0.0 forcats_1.0.0 stringr_1.5.1
## [43] purrr_1.0.2 readr_2.1.4 tidyr_1.3.0
## [46] tibble_3.2.1 ggplot2_3.4.4 tidyverse_2.0.0
## [49] lubridate_1.9.3 dplyr_1.1.4 DT_0.31
## [52] sf_1.0-14 rgdal_1.6-4 sp_2.1-2
## [55] RODBC_1.3-23 here_1.0.1
##
## loaded via a namespace (and not attached):
## [1] estimability_1.4.1 coda_0.19-4 ragg_1.2.6
## [4] bit64_4.0.5 multcomp_1.4-25 data.table_1.14.8
## [7] rpart_4.1.19 doParallel_1.0.17 generics_0.1.3
## [10] leaflet_2.2.1 terra_1.7-55 cowplot_1.1.1
## [13] TH.data_1.1-2 commonmark_1.9.0 proxy_0.4-27
## [16] bit_4.0.5 tzdb_0.4.0 webshot_0.5.5
## [19] xml2_1.3.5 httpuv_1.6.12 wk_0.9.1
## [22] assertthat_0.2.1 oai_0.4.0 xfun_0.41
## [25] hms_1.1.3 jquerylib_0.1.4 satellite_1.0.4
## [28] evaluate_0.23 promises_1.2.1 fansi_1.0.5
## [31] progress_1.2.3 DBI_1.1.3 htmlwidgets_1.6.4
## [34] stats4_4.2.2 ellipsis_0.3.2 crosstalk_1.2.1
## [37] backports_1.4.1 survey_4.2-1 markdown_1.12
## [40] epuRate_0.1 vctrs_0.6.5 geosphere_1.5-18
## [43] rnaturalearth_0.3.4 cachem_1.0.8 withr_2.5.2
## [46] triebeard_0.4.1 ggh4x_0.2.6 checkmate_2.3.0
## [49] vroom_1.6.4 emmeans_1.8.9 prettyunits_1.2.0
## [52] mclust_6.0.1 svglite_2.1.2 dotCall64_1.1-1
## [55] lazyeval_0.2.2 crayon_1.5.2 leaflet.providers_2.0.0
## [58] crul_1.4.0 pkgconfig_2.0.3 labeling_0.4.3
## [61] units_0.8-5 tweenr_2.0.2 nlme_3.1-160
## [64] nnet_7.3-18 rlang_1.1.2 lifecycle_1.0.4
## [67] sandwich_3.0-2 httpcode_0.3.0 cellranger_1.1.0
## [70] rprojroot_2.0.4 urltools_1.7.3 Matrix_1.6-4
## [73] raster_3.6-26 boot_1.3-28 zoo_1.8-12
## [76] base64enc_0.1-3 whisker_0.4.1 bitops_1.0-7
## [79] gap.datasets_0.0.6 KernSmooth_2.23-20 spam_2.10-0
## [82] classInt_0.4-10 s2_1.1.4 brew_1.0-8
## [85] jpeg_0.1-10 scales_1.3.0 lpSolve_5.6.19
## [88] magrittr_2.0.3 plyr_1.8.9 compiler_4.2.2
## [91] lme4_1.1-35.1 cli_3.6.1 pbapply_1.7-2
## [94] TMB_1.9.9 htmlTable_2.4.2 Formula_1.2-5
## [97] mgcv_1.8-41 tidyselect_1.2.0 stringi_1.8.2
## [100] textshaping_0.3.7 DistributionUtils_0.6-1 highr_0.10
## [103] mitools_2.4 yaml_2.3.7 grid_4.2.2
## [106] sass_0.4.7 tools_4.2.2 timechange_0.2.0
## [109] rstudioapi_0.15.0 uuid_1.1-1 foreach_1.5.2
## [112] foreign_0.8-83 rjags_4-15 leafpop_0.1.0
## [115] farver_2.1.1 digest_0.6.33 shiny_1.8.0
## [118] qgam_1.3.4 autocogs_0.1.4 Rcpp_1.0.11
## [121] MCMCvis_0.16.3 gridtext_0.1.5 later_1.3.1
## [124] httr_1.4.7 Rdpack_2.6 colorspace_2.1-0
## [127] splines_4.2.2 fields_15.2 systemfonts_1.0.5
## [130] xtable_1.8-4 jsonlite_1.8.7 nloptr_2.0.3
## [133] leafem_0.2.3 gap_1.5-3 R6_2.5.1
## [136] Hmisc_5.1-1 pillar_1.9.0 htmltools_0.5.7
## [139] mime_0.12 glue_1.6.2 fastmap_1.1.1
## [142] minqa_1.2.6 class_7.3-20 codetools_0.2-18
## [145] maps_3.4.1.1 mvtnorm_1.2-4 utf8_1.2.4
## [148] bslib_0.6.1 numDeriv_2016.8-1.1 curl_5.1.0
## [151] unmarked_1.3.2 survival_3.4-0 rmarkdown_2.25
## [154] munsell_0.5.0 e1071_1.7-13 iterators_1.0.14
## [157] gtable_0.3.4 rbibutils_2.2.16
By Sam Safran